unit unit_fmLogFile;

interface

uses
  Windows,
  Classes, SysUtils,
  {DsgnIntf,}
  ShellAPI,
  Forms;

{
type TLogFileEd = class(TDefaultEditor)
  procedure ExecuteVerb(Index: integer); override;
  function GetVerb(Index: integer): string; override;
  function GetVerbCount: integer; override;
  end;
}

type
//
// TfmLogRecord
//
TLogRecordType = (rtDefault, rtComment, rtInformation, rtDateStamp, rtTimeStamp,
  rtDateTimeStamp);

TfmLogFile = class(TComponent)
  private
    //
    // log file parameters
    //
    FLogFileStream: TFileStream;
    FDailyFileName: boolean; //adds yyyymmdd before filename
    FActive: boolean;
    FCreateLogDir: Boolean;
    //
    // log record related parameters
    //
    FDefRecordType: TLogRecordType;
    //--------------------------------------------------------------------------
    // class properties' initialization routines
    //--------------------------------------------------------------------------
    procedure SetDefRecordType(const Value: TLogRecordType);
    //
    function GetLogFileName: AnsiString;
  public
    //
    // General class function (constructor, destructor, etc)
    //
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    //
    // Log file create/open/CloseFile/delete functions
    //
    function CreateFile(const FileName: AnsiString = 'information.log'; const
        AccessMode: Word = fmShareDenyWrite): Boolean;
    function OpenFile(const FileName: AnsiString = 'information.log'; const
        AccessMode: Word = fmShareDenyWrite): Boolean;
    procedure CloseFile;
    function Delete: Boolean;
    //
    procedure WriteToLog(const LogMessage: AnsiString; const RecordType:
        TLogRecordType = rtDefault);
  published
    property Active: boolean read FActive;
    property FileName: AnsiString read GetLogFileName;
    property CreateLogDir: Boolean read FCreateLogDir write FCreateLogDir;
    property DailyFileName: boolean read FDailyFileName write FDailyFileName;
    //
    property DefRecordType: TLogRecordType read FDefRecordType write
        SetDefRecordType;
  end;

procedure Register;

implementation

const
  EOLN = #13 + #10;
  SPACE_CHAR = #32;
  COMMENT_PREFIX = '; ';
  //
  ABS_PATH_COLON_POS = 2;
  ABS_PATH_COLON = ':';

//------------------------------------------------------------------------------
// procedure Register
//   Component TfmLogFile registration procedure 
// Parameters:
//   None
// Result:
//   None
//------------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('Genesis components', [TfmLogFile]);
end;
//------------------------------------------------------------------------------
// constructor TfmLogFile.Create
//   Create exemplar of TfmLogFile class
// Parameters:
//   AOwner: TComponent - pointer to parent component 
// Result:
//   None
//------------------------------------------------------------------------------
constructor TfmLogFile.Create(AOwner: TComponent);
begin
  FDefRecordType := rtInformation;

  inherited Create(AOwner);
end;
//------------------------------------------------------------------------------
// destructor TfmLogFile.Destroy
//   Free memory and destroy exemplar of TfmLogFile class
// Parameters:
//   None
// Result:
//   None
//------------------------------------------------------------------------------
destructor TfmLogFile.Destroy;
begin
  FreeAndNil(FLogFileStream);
  inherited Destroy;
end;
//------------------------------------------------------------------------------
// procedure TfmLogFile.CloseFile
//   Close opened log file
// Parameters:
//   None
// Result:
//   None
//------------------------------------------------------------------------------
procedure TfmLogFile.CloseFile;
begin
  if FActive then begin
    FreeAndNil(FLogFileStream);
    FActive := False;
  end;
end;
//------------------------------------------------------------------------------
// function TfmLogFile.CreateFile
//   Create log file with specified access mode
// Parameters:
//   const FileName: AnsiString - log file filename. MUST BE in absolute format
//   const AccessMode: Word - log file access mode
// Result: Boolean
//   True, if operation succeed, False otherwise
//------------------------------------------------------------------------------
function TfmLogFile.CreateFile(const FileName: AnsiString = 'information.log';
    const AccessMode: Word = fmShareDenyWrite): Boolean;
var
  y,m,d: word;
  cFileName: AnsiString;
  cFilePath: AnsiString;
  cCurrentDay: AnsiString;
  bDeleteFile: Boolean;
  bCreateDir: Boolean;
begin
  Result := False;
  //
  // if Log file is active, CloseFile curent log file
  //
  if FActive then begin
    FreeAndNil(FLogFileStream);
    FActive := False;
  end;
  //
  // Generate log file filename
  //
  if FDailyFileName then
  begin
    DecodeDate(Now,y,m,d);
    cCurrentDay := Format('%.04d%.02d%.02d_',[y,m,d]);
  end
  else
  begin
    cCurrentDay := '';
  end;
  cFileName :=
    ExtractFilePath(FileName) + cCurrentDay + ExtractFileName(FileName);
  //
  // if file already exists, delete it
  //
  bDeleteFile := True;
  if FileExists(FileName) then
    bDeleteFile := DeleteFile(FileName);
  //
  // Set result to False and Exit function, if error occured
  //
  if not bDeleteFile then begin
    Result := False;
    Exit;
  end;
  //
  // Check if directory exists. If not, create it.
  //
  bCreateDir := True;
  if FCreateLogDir then begin
    cFilePath := ExtractFileDir(cFileName);
    bCreateDir := ForceDirectories(cFilePath);
  end;
  //
  // Set result to False and Exit function, if directory don't created
  //
  if not bCreateDir then begin
    Result := False;
    Exit;
  end;
  //
  // Create new log file and close it (create function cannot assign access mode)
  //
  FLogFileStream := TFileStream.Create(cFileName, fmCreate);
  FreeAndNil(FLogFileStream);
  //
  // Set log file access mode
  //
  FLogFileStream :=
    TFileStream.Create(cFileName, fmOpenWrite + AccessMode);
  FLogFileStream.Seek(0,soFromBeginning);
  //
  // Assign internal log file's filename variable, set result and exit function
  //
  FActive := FLogFileStream <> nil;
  Result := FActive;
end;
//------------------------------------------------------------------------------
// function TfmLogFile.Delete
//   Delete currently assigned log file from disk
// Parameters:
//   None
// Result: Boolean
//   True, if operation succeed; False otherwise
//   Variable FActive is set to False after processing function
//------------------------------------------------------------------------------
function TfmLogFile.Delete: Boolean;
var
  cFileName: AnsiString;
begin
  if FActive then begin
    cFileName := Self.FileName; //cannot get filename after unload FLogFileStream
    FreeAndNil(FLogFileStream);
    FActive := False;
    //
    DeleteFile(cFileName);
  end;
end;
//------------------------------------------------------------------------------
// function TfmLogFile.GetLogFileName
//   Returns current log file filename
// Parameters:
//   None
// Result: AnsiString
//   Currently opened log file filename
//------------------------------------------------------------------------------
function TfmLogFile.GetLogFileName: AnsiString;
begin
  //
  // if log file is opened, result is log file filename.
  //   if not, result is empty string
  //
  if FActive then begin
    Result := FLogFileStream.FileName;
  end
  else
    Result := '';
end;

//------------------------------------------------------------------------------
// function TfmLogFile.OpenFile
//   Open existing log file with specified access mode to append
//   Log file created first, if it doesn't exists.
// Parameters:
//   const FileName: AnsiString - log file filename
//   const AccessMode: Word - log file access mode
// Result: Boolean
//   True, if operation succeed, False otherwise
//------------------------------------------------------------------------------
function TfmLogFile.OpenFile(const FileName: AnsiString = 'information.log';
    const AccessMode: Word = fmShareDenyWrite): Boolean;
var
  bDeleteFile: Boolean;
begin
  Result := False;
  //
  // if Log file is active, CloseFile curent log file
  //
  if FActive then begin
    FreeAndNil(FLogFileStream);
    FActive := False;
  end;
  //
  // if file don't exists, create it
  //
  if not FileExists(FileName) then begin
    Result := Self.CreateFile(FileName, AccessMode);
    Exit;  // function CreateFile already create log file, exit function
  end;
  //
  // otherwise, open existing log file to append new records
  //
  FLogFileStream :=
    TFileStream.Create(FileName, fmOpenWrite + AccessMode);
  FLogFileStream.Seek(0,soFromEnd);
  //
  // Assign internal log file filename variable, set result and exit function
  //
  FActive := FLogFileStream <> nil;
  Result := FActive;
end;
//------------------------------------------------------------------------------
// procedure TfmLogFile.WriteToLog
//   Add specified string to log file
// Parameters:
//   const LogMessafe: AnsiString - message string
//   const RecordType: TLogRecordType - message string's type
// Result:
//   None
//------------------------------------------------------------------------------
procedure TfmLogFile.WriteToLog(const LogMessage: AnsiString; const RecordType:
    TLogRecordType = rtDefault);
var
  xRecordType : TLogRecordType;
  strMessage: AnsiString;
begin
  //
  // Check if exemplar of log file class is created; if not, exit
  //
  if Self = nil then begin
    Exit;
  end;
  //
  // Check if log file is active; if ot, exit
  //
  if FActive = False then
    Exit;
  //
  // Define message type variable
  //
  if RecordType = rtDefault then
    xRecordType := FDefRecordType
  else
    xRecordType := RecordType;
  //
  // Generate log file message selon record's type
  //
  case xRecordType of
    rtComment: begin // commentary message
      strMessage := COMMENT_PREFIX + LogMessage + EOLN;
    end;
    rtInformation: begin  // standart log message
      strMessage := LogMessage + EOLN;
    end;
    rtDateStamp: begin // log message with date prefix
      strMessage := '<'+DateToStr(Now)+'> ' + LogMessage + EOLN;
    end;
    rtTimeStamp: begin // log message with time prefix
      strMessage := '<'+TimeToStr(Now)+'> ' + LogMessage + EOLN;
    end;
    rtDateTimeStamp: begin // log message with datetime prefix
      strMessage := '<'+DateTimeToStr(Now)+'> ' + LogMessage + EOLN;
    end;
  else
    Exit; // if type is unsupported, skip processing
  end;
  //
  // Write log message to log file, free log file variable on exit
  //
  try
    FLogFileStream.Write(Pointer(strMessage)^, Length(strMessage));
  except
  end;
end;
//------------------------------------------------------------------------------
// procedure TfmLogFile.SetDefRecordType
//   Assign value to FDefRecordType field
// Parameters:
//   const Value: TLogRecordType - value to assign
// Result:
//   None
//------------------------------------------------------------------------------
procedure TfmLogFile.SetDefRecordType(const Value: TLogRecordType);
begin
  if Value <> FDefRecordType then
    FDefRecordType := Value;
end;

end.
